home *** CD-ROM | disk | FTP | other *** search
/ Archive Magazine CD 1995 / Archive Magazine CD 1995.iso / discs / prog_disc / volume_8 / issue_01 / adv_basic / !OLE / !RunImage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1994-08-18  |  6.7 KB  |  262 lines
  1.            >!RunImage
  2.  Program   Test Program For OLE
  3.  if OLE directory already exists then delete it, then create
  4.  it again...
  5. shell_FileExists("<Wimp$ScrapDir>.OLE") 
  6. ("Wipe <Wimp$ScrapDir>.OLE ~CFR~V")
  7. ("CDir <Wimp$ScrapDir>.OLE")
  8.  "OS_ReadMonotonicTime" 
  9.  earliest_time%
  10. earliest_time% += 200
  11.  quit%:
  12.  start of poll loop                         
  13.  "Wimp_PollIdle",0,bk%,earliest_time% 
  14.  reason%
  15.  reason% 
  16.   0   :
  17. backgroundtask
  18.   2   :
  19.  "Wimp_OpenWindow",,bk%
  20.   3   :
  21.  "Wimp_CloseWindow",,bk%
  22.   6   :
  23. button
  24.   9   :
  25. menuselect
  26.  17,18:
  27. message
  28.  now tidy up again by deleting the scrap directory (is this
  29.  really a good idea - maybe another program is using it!)
  30.  for demo purposes I don't want extra directories left inside
  31.  !Scrap though..
  32. shell_FileExists("<Wimp$ScrapDir>.OLE") 
  33. ("Wipe <Wimp$ScrapDir>.OLE ~CFR~V")
  34.  "Wimp_CloseDown"
  35. button
  36.  bk%!8 
  37.  read button state
  38.  bk%!12=-2 
  39. -5     
  40.  if Menu pressed over iconbar, create menu 
  41. .0     
  42.  "Wimp_CreateMenu",,menu%,!bk%-64,184
  43.  bk%!12 
  44.      
  45. 3,       
  46.  <SELECT> used on iconbar icon..
  47.        !bk%= mainw%
  48. 5(       
  49.  "Wimp_GetWindowState",,bk%
  50.        bk%!28 = -1
  51. 7$       
  52.  "Wimp_OpenWindow",,bk%
  53.      
  54.  mainw%
  55. 90       $buff% = 
  56. shell_IconGetData(mainw%,1)
  57. :0       X% = 
  58. ("<Wimp$ScrapDir>.OLE.File001")
  59. ;0       
  60.  "OS_GBPB",2,X%,buff%,
  61. ($buff%) + 1
  62.        
  63. =7       
  64. ("SetType <Wimp$ScrapDir>.OLE.File001 FFF")
  65. >C       
  66. MessageSendDataLoad(&FFF,"<Wimp$ScrapDir>.OLE.File001")
  67. ?N       datestamp% = 
  68. shell_FileGetDateStamp("<Wimp$ScrapDir>.OLE.File001")
  69.        ole_transfer% = 
  70. menuselect
  71.  button%
  72.  "Wimp_GetPointerInfo",,bk%+256
  73.  read button state
  74. I+button%=bk%!264                        
  75.  !bk% 
  76.  quit if item 1 chosen
  77. M$   quit%=
  78.                       
  79.  re-open menu if Adjust was  pressed
  80.  button%=1 
  81.  "Wimp_CreateMenu",,menu%:
  82. message
  83.  filename$
  84.  bk%!16 
  85. VG                                         
  86.  read message action code
  87.  0:quit%=
  88. :                      
  89.  quit if Quit message received
  90. string(a%)                        
  91.  convert a null-terminated string into CR-terminated
  92.  ?a%<>0
  93.  a$+=
  94. ?a%:a%+=1
  95.  bk% 2000,menu% 75,ind% 2000,name% 11
  96. quit%=0:name$="OLE"
  97. err%=0
  98.  "OS_ReadVarVal","OLE$Dir",bk%,255,0,3 
  99.  ,,i%
  100. bk%?i%=13:dir$=$bk%
  101.  "Wimp_Initialise",200,&4B534154,name$
  102. error:
  103.  "Wimp_OpenTemplate",,dir$+".Templates"
  104. i%=ind%
  105. infohan%=
  106. create("InfoBox")
  107. mainw%  =
  108. create("mainw")
  109.  "Wimp_CloseTemplate"
  110. q%!bk%=-1:bk%!4=0:bk%!8=0:bk%!12=68
  111. r+bk%!16=68:bk%!20=&3002:$(bk%+24)="!OLE"
  112.  "Wimp_CreateIcon",,bk%
  113. setupmenu(menu%)
  114. u+buff% = 
  115. _heap_get(256):
  116.  text buffer..
  117. ole_transfer% = 
  118. setupmenu(m%)
  119.  $m%,num%:len%=
  120. ($m%)-2
  121. {!m%!12=&70207:m%!20=44:m%!24=0
  122. m%+=28:
  123.  i%=1 
  124.  num%
  125.  !m%=-&80*(i%=num%):
  126.  m%!4
  127. ~# m%!8=&7009021:
  128.  a$:$(m%+12)=a$
  129. a$>len% len%=
  130.  m%+=24
  131. :menu%!16=16*(len%+1)
  132. create(a$)
  133. $name%=a$
  134.  "Wimp_LoadTemplate",,bk%,i%,ind%+2000,-1,name%,0 
  135.  ,,i%
  136.  "Wimp_CreateWindow",,bk% 
  137.  handle%
  138. =handle%
  139. error
  140. report(
  141. $+" - internal error code "+
  142.  "Wimp_CloseDown"
  143. report(a$,x%)
  144. !bk%=1:$(bk%+4)=a$+
  145.  "Wimp_ReportError",bk%,x%,name$
  146.  OLE,2,infohan%,Info,-1,Quit
  147.  --- Memory Management Routines ----------------------------------------
  148. _heap_get(size%)
  149.  ptr%,heap%,flags%
  150.  Returns pointer to new memory block unless claim fails
  151.  in which case -1 is returned
  152.  First find start address of RMA..
  153.  "OS_ReadDynamicArea",1 
  154.  heap%
  155.  Now claim memory, trapping errors by using X form of SWI..
  156.  "XOS_Module",6,,,size% 
  157.  ,,ptr%;flags%
  158.  If error occured return -1, else return address of allocated
  159.  block
  160.  (flags% 
  161.  ptr% = -1
  162. = ptr%
  163. _heap_release(
  164.  ptr%)
  165.  maxfree%,nrpages%,flags%
  166.  Returns  0 if block released OK
  167.  Returns -1 if operation failed (i.e. block doesn't exist)
  168.  "XOS_Module",7,,ptr% 
  169.  ;flags%:
  170.  Free the block
  171.  (flags% 
  172.  1) = 0 
  173.  Block was released successfully...
  174.   ptr% = 0
  175.  Error occured trying to free the block, return -1 to signal to the
  176.  program that something went wrong (normally the program would ignore
  177.  this anyway)
  178.   ptr% = -1
  179. shell_IconGetData(whandle%,ihandle%)
  180.  result$,icon_blk%
  181. icon_blk%=
  182. _heap_get(40)
  183. icon_blk%!0=whandle%
  184. icon_blk%!4=ihandle%
  185.  "Wimp_GetIconState",,icon_blk%
  186.  (icon_blk%!24 
  187.  (1<<8))<>0 
  188.  result$=$(icon_blk%!28) 
  189.  result$=$(icon_blk%+28)
  190. _heap_release(icon_blk%)
  191. =result$
  192. shell_FileExists(object$)
  193.  type%
  194.  "OS_File",5,object$ 
  195.  type%
  196.  type% = 0 
  197. shell_FileGetDateStamp(object$)
  198.  type%,stamp%
  199.  "OS_File",5,object$ 
  200.  type%,,,stamp%
  201.  type% = 0 
  202. = stamp%
  203. MessageSendDataLoad(type%,name$)
  204.  msg_blk%
  205. !msg_blk%    = 
  206. _heap_get(256)
  207. *msg_blk%!00 = 256   :
  208.  Size of message
  209. Fmsg_blk%!12 = 0     :
  210.  your_ref (0 = original message not a reply)
  211. 7msg_blk%!16 = 5     :
  212.  DataOpen message action code
  213. Lmsg_blk%!20 = 0     :
  214.  Normally Filer window handle containing the file 
  215. ?msg_blk%!28 = 0     :
  216.  Normally x offset of icon clicked on
  217. ?msg_blk%!32 = 0     :
  218.  Normally y offset of icon clicked on
  219. $msg_blk%!36 = 0     :
  220.  Must be 0
  221. $msg_blk%!40 = type% :
  222.  File type
  223. #$(msg_blk% + 44) = name$ + 
  224.  "Wimp_SendMessage",17,msg_blk%,0
  225. _heap_release(msg_blk%)
  226. backgroundtask
  227.  date%,newtime%
  228.  ole_transfer% 
  229. D  date% = 
  230. shell_FileGetDateStamp("<Wimp$ScrapDir>.OLE.File001")
  231.  date% <> datestamp% 
  232.     datestamp% = date%
  233. 6    
  234. ("LOAD <Wimp$ScrapDir>.OLE.File001 "+
  235. ~buff%)
  236. -    
  237. shell_IconPutData(mainw%,1,$buff%,
  238.  "OS_ReadMonotonicTime" 
  239.  newtime%
  240.  (newtime% - earliest_time%) > 0
  241.   earliest_time% += 200
  242. shell_IconPutData(whandle%,ihandle%,data$,redraw)
  243.  blk%,old_str$
  244. 4old_str$ = 
  245. shell_IconGetData(whandle%,ihandle%)
  246.  data$ <> old_str$ 
  247.   blk%=
  248. _heap_get(40)
  249.   blk%!0 = whandle%
  250.   blk%!4 = ihandle%
  251.  "Wimp_GetIconState",,blk%
  252.  (blk%!24 
  253.  (1<<8)) <> 0 
  254.     $(blk%!28) = data$
  255. !    $(blk% + 28) = 
  256. data$,11)
  257.  redraw <> 0 
  258.     blk%!8 = 0:blk%!12 = 0
  259. $    
  260.  "Wimp_SetIconState",,blk%
  261. _heap_release(blk%)
  262.